perm filename A[P11,LCS] blob sn#519477 filedate 1980-06-30 generic text, type T, neo UTF8
CFORS3     FORTRAN UNIT GENERATOR ROUTINE   *** MUSIC V ***     
      SUBROUTINE FORSAM   
	DIMENSION ENVP(27),COSP(27)
C COSP & ENVP STORE POINTERS FOR 'COS' & 'ENV' ARRAYS. SEE AT 105 FOR INFO.
	COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
      COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN,PINCR
	1 /XIN/AMP,FREQ
	COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C  INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
      EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
     1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(  
     2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
	3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
      XNFUN=LFUNC-1      
C     COMMON INITIALIZATION OF GENERATORS     
CC      N1=I6+2   
CCC I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
CC  	N2=INS(N1-1)-1
CC      DO 204 J1=N1,N2      
CC      J2=J1-N1+1  
CC  	IF(INS(J1).GE.0)GO TO 201
CC  200  L(J2)=-INS(J1)
CC      M(J2)=1     
CC      GO TO 204     
CC  201  M(J2)=0     
CC  202  L(J2)=INS(J1)+I3-1 
CC      GO TO 204     
CC  203  L(J2)=INS(J1)-26262  
CC  204  CONTINUE    
CC      N3=INS(I6)  
CC  	IF(M1.LE.0)AMP=RNT(L1)      
CC   	IF(M2.LE.0)FREQ=RNT(L2)     
CC      J3=  N3 -100     
	CALL INITIT(J3)
  	AMP=RNT(L1)      
   	FREQ=RNT(L2)     
      NSAM=I5   
      NSAMX=NSAM-1
C            OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH 
      GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
	1 115,116,117,118),J3     
CC	IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C  FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C	SUBROUTINE OPT(L,M,NSAM)
C	DIMENSION L(8),M(8)     
C	COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
114     CALL OPT(L,M,NSAM)
112	RETURN
113	CALL REVERB
C ADD REVERB SUBROUTINE ONLY WHEN WANTED.  IT NEEDS EXTRA MEMORY.
117	RETURN
C 117 WILL BE FOR 'INP', READING EXTERNAL SOUND FILES.

C     UNIT GENERATORS    
C     OUTPUT BOX  
CC101   DO 270 K=0,NSAMX 
CC      J5=L2+K
CC270   ROUT(J5)=ROUT(J5)+ROUT(K+L1)
101	CALL OUTP
C CALLS 'FAIL' OUT BOX
      RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C  THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.

C     OSCILLATOR    L1,L2 = P or B   L3=B   L4=F or P   L5=P
C			AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102	CALL OSC
C  CALL 'FAIL' OSC.
	RETURN
CC 102	  SUM=RNT(L5)      
	CALL LOCGEN(M4,L4)
C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
      DO 293 J3=0,NSAMX  
      J4=INT(SUM)+L4     
      F=GENS(J4)     
C GENS(J4) IS IN FUNC STORAGE AREA.
	IF(M2.GT.0)GO TO 286
      SUM=SUM+FREQ
      GO TO 290     
 286  J4=L2+J3
      SUM=SUM+ROUT(J4)  
290     IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
 288  J5=L3+J3
	IF(M1.GT.0)GO TO 292
      ROUT(J5)=AMP*F     
      GO TO 293     
 292  J6=L1+J3
      ROUT(J5)=ROUT(J6)*F
 293  CONTINUE    
      RNT(L5)=SUM      
C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
      RETURN      

C 118 COS = CONTINUING, NEG. OSCILLATOR (FOR LEGATO)*** CAN'T PLAY CHORDS!!!
118	L9=RNT(I3)
C GET POINTER TO INS. NUM.
	SUM=COSP(L9)
C ONLY 1 COS PER INSTRUMENT AT THIS TIME*****************
	GO TO 218
C NOW JUMP AND ACT LIKE A 'NOS'.

C 115 NEG OSCILLATOR  L1,L2 = P or B   L3=B   L4=F or P   L5=P
C 'NOS'			 AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = ROUT  =0 = PARM  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
115   SUM=RNT(L5)      
218	CALL LOCGEN(M4,L4)
C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
      DO 215 L7=0,NSAMX  
      J4=INT(SUM)+L4     
      F=GENS(J4)     
C GENS(J4) IS IN FUNC STORAGE AREA.
	IF(M2.GT.0)GO TO 915
      SUM=SUM+FREQ
      GO TO 315
915   J4=L2+L7
      SUM=SUM+ROUT(J4)  
315     IF(SUM.GE.XNFUN)GO TO 415
       IF(SUM.LT.0.0)GO TO 615
715   J5=L3+L7
	IF(M1.GT.0)GO TO 815
      ROUT(J5)=AMP*F     
      GO TO 215     
C**********
415    SUM=SUM-XNFUN
       GO TO 715
615    SUM=SUM+XNFUN
       GO TO 715
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
815   J6=L1+L7
      ROUT(J5)=ROUT(J6)*F
215   CONTINUE    
	IF(J3.EQ.18)GO TO 318
C JUMP IF THIS IS 'COS' BEING PROCESSED
      RNT(L5)=SUM      
C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
      RETURN      
318	COSP(L9)=SUM
C SAVE POINTER FOR INST. L9
	RETURN

C     ADD TWO BOX 
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
CC103      DO 258 J3=0,NSAMX    
CC	IF(M1.GT.0)XIN1=ROUT(J3+L1)
CC    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
CC      ROUT(J3+L3)=XIN1+XIN2      
CC 258  CONTINUE    
103	CALL AD2
C CALLS FAIL VERSION
      RETURN      

C 116  SUBTRACT